home *** CD-ROM | disk | FTP | other *** search
- unit MyPrintStuff;
- interface
- uses
- PrintTraps, Sound, MyGlobals, MySound, Message;
-
- procedure doSetUp;
- procedure doPrint;
-
- implementation
- var
- theItem: integer;
-
- procedure doSetUp;
- var
- confirmed: boolean;
- begin
- PrOpen;
- InitCursor;
- confirmed := PrValidate(ThePrintRec);
- confirmed := PrStlDialog(ThePrintRec);
- if PrError <> noErr then
- A_Message('Problem with style dialog', '', '', '', theItem)
- else
- PageRect := ThePrintRec^^.prInfo.rpage;
- PrClose;
- end;
-
- procedure PrintIt;
- var
- leftEdge, lineTop, lineBottom, lineSize: integer;
- title: str255;
- i: integer;
-
- procedure NumToHexString (n: longint; var s: str255);
- var
- d, i: integer;
- begin
- s := '';
- i := 32;
- while i > 0 do
- begin
- d := BitAnd(n, 15);
- n := BitShift(n, -4);
- i := i - 4;
- if d < 10 then
- s := concat(chr(ord('0') + d), s)
- else
- s := concat(chr(ord('A') + d - 10), s);
- end;
- end;
-
- procedure LineFeed;
- begin
- lineTop := lineTop + lineSize;
- lineBottom := lineBottom + lineSize;
- MoveTo(leftEdge, lineBottom);
- end;
-
- procedure PrintHeader;
- var
- s1: str255;
- begin
- s1 := 'Snd name is "';
- s1 := concat(s1, title, '"');
- MoveTo(leftEdge, lineBottom);
- TextFace([bold]);
- DrawString(s1);
- TextFace([]);
- LineFeed;
- LineFeed;
- end;
-
- procedure PrintFirstPart;
- var
- s1, s2: str255;
- num: longint;
- begin
- num := MySoundHandle^^.format;
- s1 := 'Snd Format = ';
- NumToString(num, s2);
- s1 := concat(s1, s2);
- DrawString(s1);
- LineFeed;
-
- num := MySoundHandle^^.SynthCount;
- s1 := 'Synthizers = ';
- NumToString(num, s2);
- s1 := concat(s1, s2);
- DrawString(s1);
- LineFeed;
-
- num := MySoundHandle^^.SynthType;
- s1 := 'Snd Format = ';
- NumToString(num, s2);
- s1 := concat(s1, s2, ' (noteSynth)');
- DrawString(s1);
- LineFeed;
-
- num := MySoundHandle^^.SynthInit;
- s1 := 'Snd Initialization = ';
- NumToHexString(num, s2);
- s1 := concat(s1, '$', s2);
- DrawString(s1);
- LineFeed;
-
- num := MySoundHandle^^.CommandCount;
- s1 := 'Number of Sound Commands = ';
- NumToString(num, s2);
- s1 := concat(s1, s2);
- DrawString(s1);
- LineFeed;
-
- DrawString(' # cmd param1 param2 Description');
- MoveTo(leftEdge, lineBottom + 2);
- LineTo(PageRect.right, lineBottom + 2);
- MoveTo(leftEdge, lineBottom);
- LineFeed;
- end;
-
- procedure PrintNote (i: integer);{ # cmd param1 param2 Description }
- var
- s1, s2, s3: str255;
- num: longint;
- c, p1: integer;
- p2: longint;
- begin
- c := MySoundHandle^^.MySounds[i].cmd;
- p1 := MySoundHandle^^.MySounds[i].param1;
- p2 := MySoundHandle^^.MySounds[i].param2;
-
- num := i; {put index number}
- NumToString(num, s1);
- if i < 10 then
- s1 := concat(' ', s1);
- if i < 100 then
- s1 := concat(' ', s1);
- s1 := concat(s1, ' ');
-
- NumToString(c, s2);
- if c < 10 then
- s2 := concat(' ', s2);
- s1 := concat(s1, s2, ' $');
-
- NumToHexString(p1, s2);
- NumToHexString(p2, s3);
- s1 := concat(s1, s2, ' $', s3, ' ');
-
- case c of
- quietCmd:
- begin
- s1 := concat(s1, 'quietCmd - The End');
- end;
- timbreCmd:
- begin
- s1 := concat(s1, 'timbreCmd - Value ');
- NumToString(p1, s2);
- s1 := concat(s1, s2);
- end;
- restCmd:
- begin
- s1 := concat(s1, 'restCmd - Rest ');
- NumToString(p1, s2);
- s1 := concat(s1, s2, ' milliseconds');
- end;
- noteCmd:
- begin
- s1 := concat(s1, 'noteCmd - Note ');
- num := BitAnd(p2, $FF);
- NumToString(num, s2);
- s1 := concat(s1, s2, ', Amp. ');
- num := BitAnd(BitShift(p2, -24), $FF);
- NumToString(num, s2);
- s1 := concat(s1, s2, ', Duration ');
- NumToString(p1, s2);
- s1 := concat(s1, s2, ' milliseconds');
- end;
- otherwise
- begin
- s1 := concat(s1, 'Unknown sound command');
- end;
- end;
- DrawString(s1);
- end;
-
- begin
- {set up position}
- PenNormal;
- TextFont(monaco);
- TextFace([]);
- TextSize(9);
- lineTop := PageRect.top;
- lineSize := 12;
- lineBottom := lineTop + lineSize;
- leftEdge := 30;
- GetWTitle(MyWindow, title);
- PrOpenPage(ThePrintPort, nil); {open page}
- PrintHeader; {print header}
- PrintFirstPart; {print first part}
- for i := 1 to MySoundHandle^^.CommandCount do {for each note}
- begin
- if lineBottom > PageRect.bottom then
- begin {if position is too great}
- PrClosePage(ThePrintPort);{close page}
- PrOpenPage(ThePrintPort, nil); {open page}
- lineTop := PageRect.top;
- lineBottom := lineTop + lineSize;
- PrintHeader; {print header}
- DrawString(' # cmd param1 param2 Description');
- MoveTo(leftEdge, lineBottom + 2);
- LineTo(PageRect.right, lineBottom + 2);
- MoveTo(leftEdge, lineBottom);
- LineFeed;
- end;
- PrintNote(i);{print note}
- LineFeed;
- end;
- PrClosePage(ThePrintPort);{close page}
- end;
-
- procedure doPrint;
- var
- DoIt: boolean;
- myPrPort: TPPrPort;
- savePort: GrafPtr;
- copies, count: integer;
- begin
- GetPort(savePort);
- SetCursor(arrow);
- PrOpen;
- if PrError = noErr then
- begin
- DoIt := PrValidate(ThePrintRec);
- DoIt := PrJobDialog(ThePrintRec);
- if PrError <> noErr then
- A_Message('Problem with job dialog', '', '', '', theItem);
- if DoIt then
- begin {print document}
- SetCursor(theWatch^^);
- ThePrintPort := PrOpenDoc(ThePrintRec, nil, nil);
- if PrError = noErr then
- begin {ok port}
- CreateSndResource(MyDoc^.StartValue, MyDoc^.EndValue);
- copies := ThePrintRec^^.prJob.iCopies;
- PageRect := ThePrintRec^^.prInfo.rpage;
- for count := 1 to copies do
- begin {copies loop}
- PrintIt; {print the document}
- end; {copies loop}
- DisposHandle(MyHandle);
- DisposHandle(Handle(MySoundHandle));
- MyHandle := nil;
- MySoundHandle := nil;
- end
- else {bad port}
- A_Message('Open Document Error', '', '', '', theItem);
- PrCloseDoc(ThePrintPort);
- if (ThePrintRec^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) then
- PrPicFile(ThePrintRec, nil, nil, nil, PrintStatus);
- end; {printing document}
- end;
- PrClose;
- SetPort(savePort);
- SetCursor(arrow)
- end;
-
- end.